#lang racket


(require mysterx)


(provide
 ; methods
 add-arc
 add-circle
 add-ellipse
 add-line
 add-spline
 add-box
 add-cone
 add-cylinder
 add-sphere
 add-extruded-solid
 add-region
 boolean
 delete
 get-bounding-box
 move
 offset
 rotate3d
 transform-by
 
 ; properties
 position
 
 ; commands
 entget)


(define autocad-coclass
  (let ((coclass-name "AutoCAD Application"))
    (with-handlers ((exn?
                     (λ (e)
                       (displayln "Starting AutoCAD...")
                       (cci/coclass coclass-name))))
      (gao/coclass coclass-name))))

(define (connect-autocad . properties)
  (define (try-connection count)
    (with-handlers ((exn?
                     (λ (e)
                       (cond ((> count 0)
                              (displayln "Waiting for AutoCAD to be ready...")
                              (sleep 1)
                              (try-connection (- count 1)))
                             (else
                              (raise e))))))
      (apply com-get-property autocad-coclass properties)))
  
  (try-connection 10))

(define autocad-document (connect-autocad "ActiveDocument"))

(define autocad-coobject (connect-autocad "ActiveDocument" "ModelSpace"))


; methods

(define (add-arc center radius start-angle end-angle)
  (com-invoke autocad-coobject "AddArc" center radius start-angle end-angle))

(define (add-circle center radius)
  (com-invoke autocad-coobject "AddCircle" center radius))

(define (add-ellipse center major-axis radius-ratio)
  (com-invoke autocad-coobject "AddEllipse" center major-axis radius-ratio))

(define (add-line start-point end-point)
  (com-invoke autocad-coobject "AddLine" start-point end-point))

(define (add-spline points start-tangent end-tangent)
  (com-invoke autocad-coobject "AddSpline" points start-tangent end-tangent))

(define (add-box origin length width height)
  (com-invoke autocad-coobject "AddBox" origin length width height))

(define (add-cone center base-radius height)
  (com-invoke autocad-coobject "AddCone" center base-radius height))

(define (add-cylinder center radius height)
  (com-invoke autocad-coobject "AddCylinder" center radius height))

(define (add-sphere center radius)
  (com-invoke autocad-coobject "AddSphere" center radius))

(define (add-extruded-solid profile height taper-angle)
  (com-invoke autocad-coobject "AddExtrudedSolid" profile height taper-angle))

(define (add-region shapes)
  (com-invoke autocad-coobject "AddRegion" shapes))

(define (boolean operation shape1 shape2)
  (com-invoke shape1 "Boolean" operation shape2)
  shape1)

(define (delete object)
  (com-invoke object "Delete"))

(define (get-bounding-box object)
  (let ((min-point (vector 0.0 0.0 0.0))
        (max-point (vector 0.0 0.0 0.0)))
    (com-invoke object "GetBoundingBox" min-point #f)
    min-point))

(define (move shape point1 point2)
  (com-invoke shape "Move" point1 point2)
  shape)

(define (offset object distance)
  (com-invoke object "Offset" distance))

(define (rotate3d shape point1 point2 rotation-angle)
  (com-invoke
   shape
   "Rotate3D"
   point1
   point2
   rotation-angle)
  shape)

(define (transform-by shape matrix)
  (com-invoke shape "TransformBy" matrix)
  shape)


; properties

(define (position object)
  (com-get-property object "position"))

(define (error-properties)
  (define a (add-sphere (vector 0.0 0.0 0.0) 1.0))
  (map
   (λ (p)
     (with-handlers
         ((exn? (λ (e)
                  (display "error in ->")
                  (display p)
                  (newline)
                  e)))
       (com-get-property a p)))
   (com-get-properties a)))


; commands

(define (send-command command)
  (com-invoke autocad-document "SendCommand" command))

(define (handent handle)
  (string-append "(handent \"" handle "\")"))

(define (entity-handle object)
  (com-get-property object "Handle"))

(define (entget entity)
  (send-command
   (string-append
    "(entget \"" (handent entity) "\")" vbCr)))

(define vbCr
  (string-append
   (string #\return)
   (string #\newline)))

(define (sweep object path)
  (com-invoke
   autocad-document
   "SendCommand"
   (string-append
    "sweep"
    " "
    (handent (entity-handle object))
    vbCr
    (handent (entity-handle path))
    vbCr)))